home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 9 / AMUG BBS in a Box Volume IX (August 1993) (MacWizards).iso / Files / Prog / T / Tabedit.cpt / Tabedit / tabedit.pas / tabedit.pas
Encoding:
Pascal/Delphi Source File  |  1987-06-22  |  9.1 KB  |  438 lines  |  [TEXT/EDIT]
  1. (******************************************************************************)
  2.  
  3. program tabedit;
  4.  
  5. (******************************************************************************)
  6.  
  7.     uses macintf;
  8.     
  9.     {$L rsrc.rel                    }
  10.     {$T APPL BRAD                }
  11.     {$B+                            }
  12.     
  13.     {$U    tabglue                }
  14.  
  15. (******************************************************************************)
  16.  
  17.     const
  18.         
  19.         applemenu        =    301;
  20.         filemenu            =    302;
  21.         editmenu            =    303;
  22.         windid                =    300;
  23.         aboutid            =    300;
  24.  
  25. (******************************************************************************)
  26.  
  27.     type
  28.         
  29.         tabrecord        =    record
  30.             tabte            :    tehandle;
  31.             tabwidth        :    integer;
  32.             lasttab        :    integer;
  33.             tabs            :    array [1..100] of integer;
  34.         end;
  35.         tabptr                =    ^tabrecord;
  36.         tabhandle        =    ^tabptr;
  37.         
  38.         longptr            =    ^long;
  39.  
  40. (******************************************************************************)
  41.  
  42.     var
  43.         
  44.         done                :    logical;
  45.         mywindow        :    windowptr;
  46.         nowte                :    tehandle;
  47.         nowtabs            :    tabhandle;
  48.         textcursor        :    curshandle;
  49.         dragarea            :    rect;
  50.         stdtedotext        :    long;
  51.         stdlinestart        :    long;
  52.         globala70        :    longptr;
  53.         global7fc            :    longptr;
  54.         myqdprocs        :    qdprocs;
  55.  
  56. (******************************************************************************)
  57.  
  58.     function tabtxmeas(bytecount : integer; textaddr : ptr;
  59.                     var numer, denom : point; var info : fontinfo) : integer; external;
  60.     procedure tabtxwrite(bytecount : integer; textbuf : ptr;
  61.                     numer, denom : point); external;
  62.     procedure tabtedotext; external;
  63.     procedure tablinestart; external;
  64.     
  65. (******************************************************************************)
  66.  
  67.     procedure setupfortabs(resid : integer; wptr : windowptr);
  68.     
  69.         var
  70.             ahndl                :    handle;
  71.             reshndl            :    handle;
  72.             tabh                :    tabhandle;
  73.             i                    :    integer;
  74.             widthzerochar    :    integer;
  75.             btabsize            :    long;
  76.         
  77.         begin
  78.             
  79.             ahndl := handle(getwrefcon(wptr));
  80.             reshndl := getresource('bTAB', resid);
  81.             btabsize := gethandlesize(reshndl);
  82.             
  83.             sethandlesize(ahndl, btabsize + 6);
  84.             tabh := tabhandle(ahndl);
  85.             
  86.             tabh^^.tabwidth := charwidth(chr(9));
  87.             
  88.             blockmove(reshndl^, @tabh^^.lasttab, btabsize);
  89.             releaseresource(reshndl);
  90.             
  91.             widthzerochar := charwidth(chr(48));
  92.             with tabh^^ do
  93.                 if lasttab <> 0 then
  94.                     for i := 1 to lasttab do
  95.                         tabs[i] := tabs[i] * widthzerochar;
  96.             
  97.             wptr^.grafprocs := @myqdprocs;
  98.         
  99.         end;
  100.     
  101. (******************************************************************************)
  102.  
  103.     procedure setupmenus;
  104.     
  105.         var
  106.             menutopic        :    menuhandle;
  107.         
  108.         begin
  109.             
  110.             menutopic := getmenu(applemenu);
  111.             addresmenu(menutopic, 'DRVR');
  112.             insertmenu(menutopic, 0);
  113.             
  114.             menutopic := getmenu(filemenu);
  115.             insertmenu(menutopic, 0);
  116.             
  117.             menutopic := getmenu(editmenu);
  118.             insertmenu(menutopic, 0);
  119.             
  120.             drawmenubar;
  121.         
  122.         end;
  123.     
  124. (******************************************************************************)
  125.  
  126.     function setuptextwindow(idno : integer) : windowptr;
  127.     
  128.         var
  129.             hndl                :    handle;
  130.             r                    :    rect;
  131.             li                    :    longptr;
  132.             myw                :    windowptr;
  133.             ate                :    tehandle;
  134.         
  135.         begin
  136.             
  137.             myw := getnewwindow(idno, nil, pointer(-1));
  138.             setport(myw);
  139.             
  140.             r := myw^.portrect;
  141.             with r do begin
  142.                 top := top + 4;
  143.                 left := left + 4;
  144.             end;
  145.             ate := tenew(r, r);
  146.             
  147.             hndl := newhandle(4);
  148.             li := longptr(hndl^);
  149.             li^ := long(ate);
  150.             setwrefcon(myw, long(hndl));
  151.             
  152.             setupfortabs(idno, myw);
  153.             
  154.             setuptextwindow := myw;
  155.         
  156.         end;
  157.     
  158. (******************************************************************************)
  159.  
  160.     procedure initialize;
  161.     
  162.         var
  163.             i                    :    integer;
  164.             r                    :    rect;
  165.         
  166.         begin
  167.             
  168.             initgraf(@theport);
  169.             initfonts;
  170.             initwindows;
  171.             initmenus;
  172.             teinit;
  173.             initdialogs(nil);
  174.             flushevents(everyevent, 0);
  175.             
  176.             r := screenbits.bounds;
  177.             setrect(dragarea, r.left + 4, r.top + 24, r.right - 4, r.bottom - 4);
  178.             done := false;
  179.             setupmenus;
  180.             
  181.             mywindow := setuptextwindow(windid);
  182.             nowtabs := tabhandle(getwrefcon(mywindow));
  183.             nowte := nowtabs^^.tabte;
  184.             
  185.             textcursor := getcursor(ibeamcursor);
  186.             hlock(handle(textcursor));
  187.             initcursor;
  188.             
  189.             globala70 := longptr($a70);
  190.             stdtedotext := globala70^;
  191.             globala70^ := long(@tabtedotext);
  192.             
  193.             global7fc := longptr($7fc);
  194.             stdlinestart := global7fc^;
  195.             global7fc^ := long(@tablinestart);
  196.             
  197.             setstdprocs(myqdprocs);
  198.             myqdprocs.txmeasproc := @tabtxmeas;
  199.             myqdprocs.textproc := @tabtxwrite;
  200.         
  201.         end;
  202.     
  203. (******************************************************************************)
  204.  
  205.     procedure processmenu(codeword : long);
  206.     
  207.         var
  208.             i                    :    integer;
  209.             menuno            :    integer;
  210.             itemno            :    integer;
  211.             nameholder        :    str255;
  212.             dna                :    integer;
  213.             ourdlg                :    dialogptr;
  214.         
  215.         begin
  216.             
  217.             if codeword <> 0 then begin
  218.             
  219.                 menuno := hiword(codeword);
  220.                 itemno := loword(codeword);
  221.                 
  222.                 case menuno of
  223.                     
  224.                     applemenu    :    begin
  225.                         
  226.                         if itemno = 1 then begin
  227.                             ourdlg := getnewdialog(aboutid, nil, pointer(-1));
  228.                             modaldialog(nil, i);
  229.                             disposdialog(ourdlg);
  230.                         end else begin
  231.                             getitem(getmhandle(applemenu), itemno, nameholder);
  232.                             dna := opendeskacc(nameholder);
  233.                         end;
  234.                     
  235.                     end;
  236.                     
  237.                     filemenu        :    begin
  238.                         
  239.                         case itemno of
  240.                             1    :    begin
  241.                                 mywindow := setuptextwindow(windid);
  242.                                 nowtabs := tabhandle(getwrefcon(mywindow));
  243.                                 nowte := nowtabs^^.tabte;
  244.                                 disableitem(getmhandle(filemenu), 1);
  245.                             end;
  246.                             2    :    done := true;
  247.                         end;
  248.                     
  249.                     end;
  250.                     
  251.                     editmenu        :    begin
  252.                         
  253.                         if not systemedit(itemno - 1) then case itemno of
  254.                             3    :    tecut(nowte);
  255.                             4    :    tecopy(nowte);
  256.                             5    :    tepaste(nowte);
  257.                             6    :    tedelete(nowte);
  258.                         end;
  259.                     
  260.                     end;
  261.                 
  262.                 end;
  263.                 
  264.             end;
  265.             
  266.             hilitemenu(0);
  267.         
  268.         end;
  269.     
  270. (******************************************************************************)
  271.  
  272.     procedure mousedowns(event : eventrecord);
  273.     
  274.         var
  275.             pointedto            :    windowptr;
  276.             mouseloc            :    point;
  277.             windowloc        :    integer;
  278.         
  279.         begin
  280.             
  281.             mouseloc := event.where;
  282.             windowloc := findwindow(mouseloc, pointedto);
  283.             
  284.             case windowloc of
  285.                 
  286.                 inmenubar    :    processmenu(menuselect(mouseloc));
  287.                 insyswindow    :    systemclick(event, pointedto);
  288.                 
  289.             otherwise
  290.                 if pointedto <> frontwindow then
  291.                     selectwindow(pointedto)
  292.                 else case windowloc of
  293.                     
  294.                     incontent        :    begin
  295.                         globaltolocal(mouseloc);
  296.                         if bitand(event.modifiers, shiftkey) = shiftkey then
  297.                             teclick(mouseloc, true, nowte)
  298.                         else
  299.                             teclick(mouseloc, false, nowte);
  300.                     end;
  301.                     
  302.                     indrag        :    dragwindow(pointedto, mouseloc, dragarea);
  303.                     
  304.                     ingoaway        :    if trackgoaway(pointedto, mouseloc) then begin
  305.                         tedispose(nowte);
  306.                         disposhandle(handle(nowtabs));
  307.                         nowtabs := nil;
  308.                         disposewindow(pointedto);
  309.                         enableitem(getmhandle(filemenu), 1);
  310.                     end;
  311.                 
  312.                 end;
  313.                     
  314.             end;
  315.         
  316.         end;
  317.     
  318. (******************************************************************************)
  319.  
  320.     procedure keydowns(event : eventrecord);
  321.     
  322.         var
  323.             charcode            :    char;
  324.         
  325.         begin
  326.             
  327.             charcode := chr(bitand(event.message, charcodemask));
  328.             
  329.             if bitand(event.modifiers, cmdkey) = cmdkey then
  330.                 processmenu(menukey(charcode))
  331.             else
  332.                 tekey(charcode, nowte);
  333.         
  334.         end;
  335.     
  336. (******************************************************************************)
  337.  
  338.     procedure activates(event : eventrecord);
  339.     
  340.         var
  341.             targetwindow    :    windowptr;
  342.             active                :    logical;
  343.             ahndl                :    handle;
  344.         
  345.         begin
  346.             
  347.             targetwindow := windowptr(event.message);
  348.             active := odd(event.modifiers);
  349.             
  350.             if active then begin
  351.                 setport(targetwindow);
  352.                 nowtabs := tabhandle(getwrefcon(targetwindow));
  353.                 nowte := nowtabs^^.tabte;
  354.                 teactivate(nowte);
  355.             end else begin
  356.                 tedeactivate(nowte);
  357.                 nowtabs := nil;
  358.             end;
  359.         
  360.         end;
  361.     
  362. (******************************************************************************)
  363.  
  364.     procedure updates(event : eventrecord);
  365.     
  366.         var
  367.             updatewindow    :    windowptr;
  368.             saveport            :    windowptr;
  369.             temptabs            :    tabhandle;
  370.         
  371.         begin
  372.             
  373.             updatewindow := windowptr(event.message);
  374.             getport(saveport);
  375.             temptabs := nowtabs;
  376.             setport(updatewindow);
  377.             nowtabs := tabhandle(getwrefcon(updatewindow));
  378.             
  379.             beginupdate(updatewindow);
  380.             eraserect(updatewindow^.visrgn^^.rgnbbox);
  381.             with nowtabs^^ do
  382.                 teupdate(tabte^^.viewrect, tabte);
  383.             endupdate(updatewindow);
  384.             
  385.             setport(saveport);
  386.             nowtabs := temptabs;
  387.         
  388.         end;
  389.     
  390. (******************************************************************************)
  391.  
  392.     procedure maineventloop;
  393.     
  394.         var
  395.             event                :    eventrecord;
  396.             mousept            :    point;
  397.         
  398.         begin
  399.             
  400.             repeat
  401.                 
  402.                 systemtask;
  403.                 
  404.                 if mywindow = frontwindow then begin
  405.                     getmouse(mousept);
  406.                     if ptinrect(mousept, nowte^^.viewrect) then
  407.                         setcursor(textcursor^^)
  408.                     else
  409.                         setcursor(arrow);
  410.                     teidle(nowte);
  411.                 end;
  412.                 
  413.                 if getnextevent(everyevent, event) then
  414.                     case event.what of
  415.                         mousedown        :    mousedowns(event);
  416.                         keydown            :    keydowns(event);
  417.                         autokey            :    keydowns(event);
  418.                         activateevt        :    activates(event);
  419.                         updateevt        :    updates(event);
  420.                     end;
  421.             
  422.             until done;
  423.         
  424.         end;
  425.     
  426. (******************************************************************************)
  427.  
  428.         begin
  429.             
  430.             initialize;
  431.             maineventloop;
  432.             globala70^ := stdtedotext;
  433.             global7fc^ := stdlinestart;
  434.         
  435.         end.
  436.     
  437. (******************************************************************************)
  438.